home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / ifp1s155.zip / PAGE_09.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-21  |  18KB  |  678 lines
  1. unit page_09;
  2.  
  3. interface
  4.  
  5. uses crt, dos, ifpglobl, ifpcomon;
  6.  
  7. procedure page09;
  8.  
  9. implementation
  10.  
  11. procedure page09;
  12.   const
  13.     weekday: array[0..6] of string[9] = ('Sunday', 'Monday', 'Tuesday',
  14.         'Wednesday', 'Thursday', 'Friday', 'Saturday');
  15.  
  16.   var
  17.     foundit, xbool, wasone: boolean;
  18.     xbyte: byte;
  19.     xchar: char;
  20.     xstring1: string;
  21.     xstring2: string;
  22.     xword1: word;
  23.     xword2: word;
  24.     xword3: word;
  25.     xword4: word;
  26.     xword5: word;
  27.     xword6: word;
  28.     xword7: word;
  29.     xword8: word;
  30.     listseg, listofs: word;
  31.     filecount, usedfiles, tablesize: word;
  32.     dt: DateTime;
  33.     s: string;
  34.  
  35.   procedure showecho(a: word);
  36.     var
  37.       xbyte : byte;
  38.  
  39.     begin
  40.     xbyte:=Mem[DOScseg : a];
  41.     case xbyte of
  42.       $00 : Writeln('off');
  43.       $FF : Writeln('on')
  44.     else
  45.       unknown('status', xbyte, 2)
  46.     end
  47.     end; {showecho}
  48.  
  49.   procedure showbufs(a : word);
  50.     const
  51.       bufsmax = 99;
  52.  
  53.     var
  54.       i : 0..bufsmax + 1;
  55.       xbool : boolean;
  56.       xword1 : word;
  57.       xword2 : word;
  58.       xword3 : word;
  59.  
  60.     begin
  61.     if (osmajor < 4) or (osmajor >= 10) then
  62.       begin
  63.       i:=0;
  64.       xword1:=MemW[DOScseg : a];
  65.       xword2:=MemW[DOScseg : a + 2];
  66.       xbool:=false;
  67.       repeat
  68.         if i <= bufsmax then
  69.           begin
  70.           if xword1 < $FFFF then
  71.             begin
  72.             inc(i);
  73.             xword3:=xword1;
  74.             xword1:=memw[xword2 : xword3];
  75.             xword2:=memw[xword2 : xword3 + 2]
  76.             end
  77.           else
  78.             begin
  79.             xbool:=true;
  80.             Writeln(i)
  81.             end
  82.           end
  83.         else
  84.           begin
  85.           xbool:=true;
  86.           dontknow
  87.           end
  88.       until xbool
  89.       end
  90.     else
  91.       with regs do
  92.         begin
  93.         AX:=$5200;
  94.         MsDos(regs);
  95.         Write(MemW[ES:BX + $3F]:5);
  96.         caption3('Read-ahead');
  97.         Writeln(MemW[ES:BX + $41]);
  98.         if osmajor = 4 then
  99.           begin
  100.           caption3('in EMS');
  101.           xword2:=MemW[ES:BX + $12];
  102.           xword1:=MemW[ES:BX + $14];
  103.           case Mem[xword1: xword2 + $C] of
  104.             $00: Writeln('no');
  105.             $FF: begin
  106.                  Write('yes');
  107.                  caption3('handle');
  108.                  Writeln(MemW[xword1: xword2 + $D])
  109.                  end;
  110.             $01: if Mem[xword1: xword2 + $18] = 0 then
  111.                    Writeln('no')
  112.                  else
  113.                    begin
  114.                    Write('yes');
  115.                    caption3('handle');
  116.                    Writeln(MemW[xword1: xword2 + $18])
  117.                    end;
  118.           else
  119.             dontknow
  120.           end; {case}
  121.           end
  122.         end
  123.     end; {showbufs}
  124.     (*  BIX ms.dos/secrets #2  *)
  125.  
  126.   procedure showattrib(s: string; value, mask: byte);
  127.     begin
  128.     if value and mask = mask then
  129.       begin
  130.       if wasone then
  131.         Write('/');
  132.       Write(s);
  133.       wasone:=true
  134.       end;
  135.     end; {showattrib}
  136.  
  137.   begin (* procedure page_09 *)
  138.   listseg:=devseg;
  139.   listofs:=devofs;
  140.   window(1, 3, twidth div 2, tlength - 2);
  141.   caption2('DOS version');
  142.   with regs do
  143.     begin
  144.     AX:=$4452;
  145.     Flags:=Flags and FCarry;
  146.     MsDos(regs);
  147.     if nocarry(regs) then
  148.       begin
  149.       Write('DR-DOS ');
  150.       case AX of
  151.         $1063: Writeln('3', decimal, '41');
  152.         $1065: Writeln('5', decimal, '00');
  153.         $1067: Writeln('6', decimal, '00')
  154.       else
  155.         Writeln('? code ', hex(AX, 4));
  156.       end;
  157.       end
  158.     else
  159.       if osmajor >= 10 then
  160.         begin
  161.         Write('OS/2 ', osmajor div 10, decimal);
  162.         zeropad(osminor)
  163.         end
  164.       else
  165.         showvers;
  166.     end;
  167.   with regs do
  168.     begin
  169.     AX:=$3000;
  170.     MsDos(regs);
  171.     if (AL <> osmajor) or (AH <> osminor) then
  172.       begin
  173.       caption3('SETVER''d to');
  174.       Write(AL, decimal);
  175.       zeropad(AH);
  176.       Writeln
  177.       end
  178.     end;
  179.   caption2('OEM serial number');
  180.   with regs do
  181.     begin
  182.     AX:=$3000;
  183.     BX:=0;
  184.     MsDos(regs);
  185.     Writeln(hex(BH, 2))
  186.     end;
  187.   caption2('System date');
  188.   getdate(xword1, xword2, xword3, xword4);
  189.   if xword4 < 7 then
  190.     Write(weekday[xword4])
  191.   else
  192.     Write('(', hex(xword4, 4), ')');
  193.   Write(', ');
  194.   xword5:=cbw(country[0], country[1]);
  195.   xchar:=Chr(country[11]);
  196.   case xword5 of
  197.     $0001: Writeln(xword3, xchar, xword2, xchar, xword1);
  198.     $0002: Writeln(xword1, xchar, xword2, xchar, xword3)
  199.   else
  200.     Writeln(xword2, xchar, xword3, xchar, xword1)
  201.   end;
  202.   caption2('System time');
  203.   gettime(xword1, xword2, xword3, xword4);
  204.   if country[17] and 1 = 0 then
  205.     case xword1 of
  206.       0: Write('12');
  207.       1..12: zeropad(xword1);
  208.       13..23: Write(xword1 - 12)
  209.     end
  210.   else
  211.     zeropad(xword1);
  212.   Write(Chr(country[13]));
  213.   zeropad(xword2);
  214.   Write(Chr(country[13]));
  215.   zeropad(xword3);
  216.   Write(decimal);
  217.   zeropad(xword4);
  218.   if country[17] and 1 = 0 then
  219.     if xword1 > 11 then
  220.       Write(' pm')
  221.     else
  222.       Write(' am');
  223.   Writeln;
  224.   caption2('Command load paragraph');
  225.   Writeln(hex(prefixseg, 4));
  226.   getcbreak(xbool);
  227.   offoron('Ctrl-C check', xbool);
  228.   getverify(xbool);
  229.   offoron('Disk verify', xbool);
  230.   caption2('Switch prefix character');
  231.   Writeln(switchar);
  232.   caption2('\DEV\ prefix for devices');
  233.   with regs do begin
  234.     AX:=$3702;
  235.     MSDOS(regs);
  236.     if DL = $00 then
  237.       Writeln('required')
  238.     else
  239.       Writeln('optional')
  240.   end;
  241.   caption2('Reset boot');
  242.   xword1:=memw[BIOSdseg : $72];
  243.   case xword1 of
  244.     $0000: Writeln('cold');
  245.     $1234, $1200, $EDCB: Writeln('bypass memory test');
  246.     $4321: Writeln('preserve memory');
  247.     $5678: Writeln('system suspended');
  248.     $9ABC{-25924}: Writeln('manufacturing test mode'); (*!$9ABC*)
  249.     $ABCD{-21555}: Writeln('system POST loop mode') (*!$ABCD*)
  250.   else
  251.     unknown('flag', xword1, 4)
  252.   end;
  253.   caption2('Boot disk was');
  254.   if (osmajor >= 4) and (osmajor < 10) then
  255.     with regs do
  256.       begin
  257.       AX:=$3305;
  258.       MsDos(regs);
  259.       Writeln(Chr(DL+$40), ':')
  260.       end
  261.   else
  262.     dontknow;
  263. (*  Byte 12:12 p.178  *)
  264.   with regs do begin
  265.     caption2('DOS critical flag');
  266.     AX:=$5D06;
  267.     MSDOS(regs);
  268.     segofs(DS, SI);
  269.     Writeln
  270.   end;
  271.   caption2('DOS busy flag    ');
  272.   segofs(DOScseg, DOScofs);
  273.   Writeln;
  274.   caption2('Printer echo');
  275.   case osmajor of
  276.     3 : case osminor div 10 of
  277.       0 : dontknow;
  278.       1..3 : showecho($02AC)
  279.       else
  280.         dontknow
  281.     end;
  282.       4,5 : showecho($02FE);
  283.   else
  284.       dontknow
  285.   end;
  286. (*  BIX ms.dos/secrets #501  *)
  287.   caption2('PrtSc status');
  288.   xbyte:=Mem[BIOSdseg : $0100];
  289.   case xbyte of
  290.     $00 : Writeln('ready');
  291.     $01 : Writeln('busy');
  292.     $FF : Writeln('error on last PrtSc')
  293.     else
  294.       unknown('status', xbyte, 2)
  295.   end;
  296.   caption2('Memory allocation');
  297.   with regs do begin
  298.     AX:=$5800;
  299.     MSDOS(regs);
  300.     case AL of
  301.       0: Writeln('first fit');
  302.       1: Writeln('best fit');
  303.       2..$3F,$43..$7F,$83..$FF: Writeln('last fit');
  304.       $40: Writeln('hi mem first fit');
  305.       $41: Writeln('hi mem best fit');
  306.       $42: Writeln('hi mem last fit');
  307.       $80: Writeln('frst fit,hi then low');
  308.       $81: Writeln('best fit,hi then low');
  309.       $82: Writeln('last fit,hi then low');
  310.     else
  311.       dontknow
  312.     end
  313.   end;
  314.   caption2('DOS buffers');
  315.   case osmajor of
  316.     3 : case osminor div 10 of
  317.           0 : showbufs($013F);
  318.           1..3 : showbufs($0038)
  319.         else
  320.           dontknow
  321.         end;
  322.     4,5 : showbufs(0)
  323.   else
  324.     dontknow
  325.   end;
  326.   caption2('File handle table ');
  327.   xword1:=MemW[prefixseg : $0036];
  328.   xword2:=MemW[prefixseg : $0034];
  329.   segofs(xword1, xword2);
  330.   Writeln;
  331.   caption3('length');
  332.   xword2:=MemW[listseg:listofs + 4];
  333.   xword1:=MemW[listseg:listofs + 6];
  334.   xbool:=false;
  335.   filecount:=0;
  336.   if (xword1 = $FFFF) and (xword2 = $FFFF) then
  337.     filecount:=MemW[PrefixSeg: $32]
  338.   else
  339.     repeat
  340.       xword4:=MemW[xword1:xword2];
  341.       xword3:=MemW[xword1:xword2 + 2];
  342.       filecount:=filecount + MemW[xword1:xword2 + 4];
  343.       if xword4 = $FFFF then
  344.         xbool:=true
  345.       else
  346.         begin
  347.         xword1:=xword3;
  348.         xword2:=xword4
  349.         end
  350.     until xbool;
  351.   Write(filecount:3);
  352.   caption3('used');
  353.   usedfiles:=0;
  354.   xword1:=MemW[PrefixSeg: $36];
  355.   xword2:=MemW[PrefixSeg: $34];
  356.   while Mem[xword1 : xword2] < $FF do begin
  357.     inc(usedfiles);
  358.     inc(xword2)
  359.   end;
  360.   Write(usedfiles:3);
  361.   Window(1 + twidth div 2, 3, twidth, tlength - 2);
  362.   caption2('File Control Blocks');
  363.   Writeln;
  364.   caption3('amount');
  365.   if (osmajor >= 4) or ((osmajor = 3) and (osminor > 0)) then
  366.     begin
  367.     xword3:=MemW[listseg:listofs + $1E];
  368.     xword2:=MemW[listseg:listofs + $1A];
  369.     xword1:=MemW[listseg:listofs + $1C]
  370.     end
  371.   else
  372.     begin
  373.     xword3:=MemW[listseg:listofs + $26];
  374.     xword2:=MemW[listseg:listofs + $22];
  375.     xword1:=MemW[listseg:listofs + $24]
  376.     end;
  377.   Write(MemW[xword1:xword2 + 4]:3);
  378.   if (osmajor >= 5) and (osmajor < 10) then
  379.     Writeln
  380.   else
  381.     begin
  382.     caption3('protected');
  383.     Writeln(xword3:3);
  384.     end;
  385.   caption2('Stacks');
  386.   if (osmajor = 3) or (osmajor >= 10) then
  387.     dontknow
  388.   else
  389.     begin
  390.     xword1:=MemW[listseg:listofs - 2];
  391.     xword4:=0; {# of stacks}
  392.     xword5:=0; {size of stacks}
  393.     if (Mem[xword1:0] <> $4D) or (MemW[xword1:1] <> 8) then
  394.       dontknow
  395.     else
  396.       begin
  397.       xword3:=xword1 + MemW[xword1:3] + 1;
  398.       xword2:=xword1 + 1;
  399.       xbool:=false;
  400.       repeat
  401.         xchar:=Chr(Mem[xword2:0]);
  402.         if xchar = 'S' then
  403.           begin
  404.           xword4:=MemW[xword2 + 1:2];
  405.           xword5:=MemW[xword2 + 1:6];
  406.           xbool:=true;
  407.           end;
  408.         if (xchar = 'M') or (xchar = 'Z') then
  409.           xbool:=true;
  410.         xword2:=xword2 + MemW[xword2:3] + 1;
  411.         if xword2 >= xword3 then
  412.          xbool:=true;
  413.       until xbool;
  414.       Writeln;
  415.       caption3('amount');
  416.       Write(xword4:3);
  417.       caption3('size each (bytes)');
  418.       Writeln(xword5:3);
  419.       end
  420.     end;
  421.   if osmajor = 5 then
  422.     with regs do
  423.       begin
  424.       caption2('UMBs');
  425.       AH:=$58;
  426.       AL:=2;
  427.       MsDos(regs);
  428.       if AL = 0 then
  429.         Write('NOT ');
  430.       Writeln('in DOS memory chain');
  431.       end;
  432.   Writeln;
  433.   TextColor(LightCyan);
  434.   Write('------ International Information -----');
  435.   Writeln;
  436.   caption2('Global code page');
  437.   with regs do
  438.     begin
  439.     AX:=$6601;
  440.     MsDos(Regs);
  441.     if AL = $01 then
  442.       begin
  443.       Writeln;
  444.       Caption3('Active');
  445.       Write(BX);
  446.       Caption3('Default');
  447.       Writeln(DX)
  448.       end
  449.     else
  450.       Writeln('N/A')
  451.     end;
  452.   Caption2('Country code');
  453.   Writeln(ccode);
  454.   case ccode of
  455.     785: s:='Saudi Arabia';
  456.      32: s:='Belgium';
  457.      55: s:='Brazil';
  458.       2: s:='French Canada';
  459.      42: s:='Czechoslovakia';
  460.      45: s:='Denmark';
  461.     358: s:='Finland';
  462.      33: s:='France';
  463.      49: s:='Germany';
  464.      36: s:='Hungary';
  465.      61: s:='International English';
  466.     972: s:='Israel';
  467.      39: s:='Italy';
  468.       3: s:='Latin America';
  469.      31: s:='Netherlands';
  470.      47: s:='Norway';
  471.      48: s:='Poland';
  472.     351: s:='Portugal';
  473.      34: s:='Spain';
  474.      46: s:='Sweden';
  475.      41: s:='Switzerland';
  476.      44: s:='United Kingdom';
  477.       1: s:='United States';
  478.      38: s:='Yugoslavia';
  479.   else
  480.     s:='Unknown';
  481.   end;
  482.   Caption3('Country');
  483.   Writeln(s);
  484.   caption2('Thousands separator character');
  485.   Writeln(Chr(country[7]));
  486.   caption2('Decimal separator character');
  487.   Writeln(decimal);
  488.   caption2('Data-list separator character');
  489.   Writeln(Chr(country[22]));
  490.   caption2('Date format');
  491.   xword1:=cbw(country[0], country[1]);
  492.   xchar:=Chr(country[11]);
  493.   case xword1 of
  494.     0: Writeln('USA (mm', xchar, 'dd', xchar, 'yy)');
  495.     1: Writeln('Europe (dd', xchar, 'mm', xchar, 'yy)');
  496.     2: Writeln('Japan (yy', xchar, 'mm', xchar, 'dd)')
  497.   else
  498.     unknown('format', xword1, 4)
  499.   end;
  500.   caption3('Separator character');
  501.   Writeln(xchar);
  502.   caption2('Time format');
  503.   if (country[17] and $01) = $00 then
  504.     Write('12')
  505.   else
  506.     Write('24');
  507.   Writeln('-hour');
  508.   caption3('Separator character');
  509.   Writeln(Chr(country[13]));
  510.   caption2('Currency format');
  511.   xstring1:='xxxx';
  512.   insert(Chr(country[7]), xstring1, 2);
  513.   xstring1:=xstring1 + decimal;
  514.   for i:=1 to country[16] do
  515.     xstring1:=xstring1 + 'y';
  516.   xstring2:='';
  517.   i:=2;
  518.   xchar:=Chr(country[i]);
  519.   while (i <= 6) and (xchar > #0) do
  520.     begin
  521.     xstring2:=xstring2 + xchar;
  522.     Inc(i);
  523.     xchar:=Chr(country[i])
  524.     end;
  525.   case country[15] and $03 of
  526.     $00 : xstring1:=xstring2 + xstring1;
  527.     $01 : xstring1:=xstring1 + xstring2;
  528.     $02 : xstring1:=xstring2 + ' ' + xstring1;
  529.     $03 : xstring1:=xstring1 + ' ' + xstring2;
  530.     $04 : begin
  531.           Delete(xstring1, 6, 1);
  532.           Insert(xstring2, xstring1, 6)
  533.           end
  534.   end {case};
  535.   Writeln(xstring1);
  536.   caption2('Case map call address');
  537.   segofs(cbw(country[20], country[21]), cbw(country[18], country[19]));
  538.   Writeln;
  539.   pause1;
  540.   if endit then
  541.     Exit;
  542.   Window(1, 3, twidth, tlength - 2);
  543.   ClrScr;
  544.   caption2('Open file handles');
  545.   Writeln;
  546.   xword2:=MemW[listseg:listofs + 4];
  547.   xword1:=MemW[listseg:listofs + 6];
  548.   xbool:=false;
  549.   if (xword1 = $FFFF) and (xword2 = $FFFF) then
  550.     Writeln('  Unable to determine under OS/2!')
  551.   else
  552.     begin
  553.     if osmajor = 3 then
  554.       tablesize:=$35
  555.     else
  556.       tablesize:=$3B;
  557.     repeat
  558.       pause3(-2);
  559.       if endit then
  560.         Exit;
  561.       xword4:=MemW[xword1:xword2];
  562.       xword3:=MemW[xword1:xword2 + 2];
  563.       if xword4 = $FFFF then
  564.         xbool:=true;
  565.       filecount:=MemW[xword1:xword2 + 4];
  566.       usedfiles:=0;
  567.       caption3('Table at');
  568.       segofs(xword1, xword2);
  569.       caption3('table size (handles)');
  570.       Writeln(filecount);
  571.       foundit:=false;
  572.       xword2:=xword2 + 6;
  573.       repeat
  574.         if MemW[xword1:xword2] <> 0 then
  575.           begin
  576.           pause3(-3);
  577.           if endit then
  578.             Exit;
  579.           foundit:=true;
  580.           xstring1:='';
  581.           for xword8:=xword2 + $20 to xword2 + $2A do
  582.             xstring1:=xstring1 + Chr(Mem[xword1:xword8]);
  583.           if Copy(xstring1, 9, 3) <> '   ' then
  584.             Insert('.', xstring1, 9)
  585.           else
  586.             Insert(' ', xstring1, 9);
  587.           Write('  ', xstring1);
  588.           caption3('open mode');
  589.           case MemW[xword1:xword2 + 2] and 7 of
  590.             0: Write('read');
  591.             1: Write('write');
  592.             2: Write('read/write');
  593.             3..7: Write('????');
  594.           end;
  595.           caption3('sharing mode');
  596.           case (MemW[xword1:xword2 + 2] and $70) shr 4 of
  597.             0: Write('compatible');
  598.             1: Write('deny all');
  599.             2: Write('deny write');
  600.             3: Write('deny read');
  601.             4: Write('deny none');
  602.             5..7: Write('????');
  603.           end;
  604.           caption3('inherit');
  605.           yesorno((MemW[xword1:xword2 + 2] and $80) = $80);
  606.           caption3('              attributes');
  607.           xbyte:=Mem[xword1:xword2 + 4];
  608.           wasone:=false;
  609.           showattrib('read-only', xbyte, 1);
  610.           showattrib('hidden', xbyte, 2);
  611.           showattrib('system', xbyte, 4);
  612.           showattrib('volume label', xbyte, 8);
  613.           showattrib('directory', xbyte, $10);
  614.           showattrib('archive', xbyte, $20);
  615.           if not wasone then
  616.             Write('(none)');
  617.           Writeln;
  618.           caption3('              remote');
  619.           yesorno2((MemW[xword1:xword2 + 5] and $8000) = $8000);
  620.           caption3('date');
  621.           UnPackTime(MemL[xword1:xword2 + $D], dt);
  622.           xword5:=cbw(country[0], country[1]);
  623.           xchar:=Chr(country[11]);
  624.           case xword5 of
  625.             $0001: Write(dt.day, xchar, dt.month, xchar, dt.year);
  626.             $0002: Write(dt.year, xchar, dt.month, xchar, dt.day)
  627.           else
  628.             Write(dt.month, xchar, dt.day, xchar, dt.year)
  629.           end;
  630.           caption3('time');
  631.           if country[17] and 1 = 0 then
  632.             case dt.hour of
  633.               0: Write('12');
  634.               1..12: zeropad(dt.hour);
  635.               13..23: Write(dt.hour - 12)
  636.             end
  637.           else
  638.             zeropad(dt.hour);
  639.           Write(Chr(country[13]));
  640.           zeropad(dt.min);
  641.           Write(Chr(country[13]));
  642.           zeropad(dt.sec);
  643.           if country[17] and 1 = 0 then
  644.             if dt.hour > 11 then
  645.               Write(' pm')
  646.             else
  647.               Write(' am');
  648.           Writeln;
  649.           caption3('              size (bytes)');
  650.           Write(MemL[xword1:xword2 + $11], ' (', (MemL[xword1:xword2 + $11] / 1024.0):0:1, 'K)');
  651.           if (xstring1 <> 'AUX         ') and (xstring1 <> 'CON         ') and
  652.             (xstring1 <> 'PRN         ') then
  653.               begin
  654.               caption3('owner PSP (hex)');
  655.               Write(hex(MemW[xword1:xword2 + $31], 4));
  656.               end
  657.           else
  658.             Write(' DOS device');
  659.           Inc(usedfiles);
  660.           xword2:=xword2 + tablesize;
  661.           Writeln;
  662.           end
  663.         else
  664.           Inc(usedfiles);
  665.       until usedfiles = filecount;
  666.       if not foundit then
  667.         Writeln('  (none used)');
  668.       if not xbool then
  669.         begin
  670.         xword1:=xword3;
  671.         xword2:=xword4
  672.         end;
  673.     until xbool;
  674.     end;
  675.   end;
  676.  
  677. end.
  678.